| Filename | (eval 1141)[/usr/share/perl5/CGI.pm:932] |
| Statements | Executed 68 statements in 707µs |
| Eval Invoked At | /usr/share/perl5/CGI.pm line 932 |
| Sibling evals | 1, 2, 3, 4, 5, 6 |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 16 | 2 | 1 | 29µs | 29µs | CGI::CORE:regcomp (opcode) |
| 17 | 4 | 2 | 22µs | 22µs | CGI::CORE:match (opcode) |
| 16 | 3 | 2 | 10µs | 10µs | CGI::CORE:subst (opcode) |
| 8 | 1 | 1 | 5µs | 5µs | CGI::CORE:substcont (opcode) |
| 0 | 0 | 0 | 0s | 0s | CGI::header |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package CGI; sub header { | ||||
| 2 | 1 | 10µs | 1 | 5µs | my($self,@p) = self_or_default(@_); # spent 5µs making 1 call to CGI::self_or_default |
| 3 | 1 | 100ns | my(@header); | ||
| 4 | |||||
| 5 | 1 | 6µs | return "" if $self->{'.header_printed'}++ and $HEADERS_ONCE; | ||
| 6 | |||||
| 7 | 1 | 89µs | 1 | 81µs | my($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) = # spent 81µs making 1 call to CGI::Util::rearrange |
| 8 | rearrange([['TYPE','CONTENT_TYPE','CONTENT-TYPE'], | ||||
| 9 | 'STATUS',['COOKIE','COOKIES','SET-COOKIE'],'TARGET', | ||||
| 10 | 'EXPIRES','NPH','CHARSET', | ||||
| 11 | 'ATTACHMENT','P3P'],@p); | ||||
| 12 | |||||
| 13 | # Since $cookie and $p3p may be array references, | ||||
| 14 | # we must stringify them before CR escaping is done. | ||||
| 15 | 1 | 100ns | my @cookie; | ||
| 16 | 1 | 1µs | for (ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie) { | ||
| 17 | 1 | 7µs | 2 | 43µs | my $cs = UNIVERSAL::isa($_,'CGI::Cookie') ? $_->as_string : $_; # spent 41µs making 1 call to CGI::Cookie::as_string
# spent 1µs making 1 call to UNIVERSAL::isa |
| 18 | 1 | 1µs | push(@cookie,$cs) if defined $cs and $cs ne ''; | ||
| 19 | } | ||||
| 20 | 1 | 200ns | $p3p = join ' ',@$p3p if ref($p3p) eq 'ARRAY'; | ||
| 21 | |||||
| 22 | # CR escaping for values, per RFC 822 | ||||
| 23 | 1 | 700ns | for my $header ($type,$status,@cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) { | ||
| 24 | 13 | 4µs | if (defined $header) { | ||
| 25 | # From RFC 822: | ||||
| 26 | # Unfolding is accomplished by regarding CRLF immediately | ||||
| 27 | # followed by a LWSP-char as equivalent to the LWSP-char. | ||||
| 28 | 8 | 37µs | 16 | 13µs | $header =~ s/$CRLF(\s)/$1/g; # spent 11µs making 8 calls to CGI::CORE:regcomp, avg 1µs/call
# spent 2µs making 8 calls to CGI::CORE:subst, avg 262ns/call |
| 29 | |||||
| 30 | # All other uses of newlines are invalid input. | ||||
| 31 | 8 | 47µs | 16 | 24µs | if ($header =~ m/$CRLF|\015|\012/) { # spent 18µs making 8 calls to CGI::CORE:regcomp, avg 2µs/call
# spent 6µs making 8 calls to CGI::CORE:match, avg 700ns/call |
| 32 | # shorten very long values in the diagnostic | ||||
| 33 | $header = substr($header,0,72).'...' if (length $header > 72); | ||||
| 34 | die "Invalid header value contains a newline not followed by whitespace: $header"; | ||||
| 35 | } | ||||
| 36 | } | ||||
| 37 | } | ||||
| 38 | |||||
| 39 | 1 | 300ns | $nph ||= $NPH; | ||
| 40 | |||||
| 41 | 1 | 100ns | $type ||= 'text/html' unless defined($type); | ||
| 42 | |||||
| 43 | # sets if $charset is given, gets if not | ||||
| 44 | 1 | 11µs | 1 | 6µs | $charset = $self->charset( $charset ); # spent 6µs making 1 call to CGI::charset |
| 45 | |||||
| 46 | # rearrange() was designed for the HTML portion, so we | ||||
| 47 | # need to fix it up a little. | ||||
| 48 | 1 | 600ns | for (@other) { | ||
| 49 | # Don't use \s because of perl bug 21951 | ||||
| 50 | 4 | 24µs | 4 | 15µs | next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/s; # spent 15µs making 4 calls to CGI::CORE:match, avg 4µs/call |
| 51 | 4 | 298µs | 16 | 295µs | ($_ = $header) =~ s/^(\w)(.*)/"\u$1\L$2" . ': '.$self->unescapeHTML($value)/e; # spent 258µs making 1 call to CGI::AUTOLOAD
# spent 26µs making 3 calls to CGI::unescapeHTML, avg 9µs/call
# spent 6µs making 4 calls to CGI::CORE:subst, avg 1µs/call
# spent 5µs making 8 calls to CGI::CORE:substcont, avg 650ns/call |
| 52 | } | ||||
| 53 | |||||
| 54 | 1 | 5µs | 1 | 500ns | $type .= "; charset=$charset" # spent 500ns making 1 call to CGI::CORE:match |
| 55 | if $type ne '' | ||||
| 56 | and $type !~ /\bcharset\b/ | ||||
| 57 | and defined $charset | ||||
| 58 | and $charset ne ''; | ||||
| 59 | |||||
| 60 | # Maybe future compatibility. Maybe not. | ||||
| 61 | 1 | 1µs | my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0'; | ||
| 62 | 1 | 100ns | push(@header,$protocol . ' ' . ($status || '200 OK')) if $nph; | ||
| 63 | 1 | 100ns | push(@header,"Server: " . &server_software()) if $nph; | ||
| 64 | |||||
| 65 | 1 | 900ns | push(@header,"Status: $status") if $status; | ||
| 66 | 1 | 100ns | push(@header,"Window-Target: $target") if $target; | ||
| 67 | 1 | 100ns | push(@header,"P3P: policyref=\"/w3c/p3p.xml\", CP=\"$p3p\"") if $p3p; | ||
| 68 | # push all the cookies -- there may be several | ||||
| 69 | 1 | 2µs | push(@header,map {"Set-Cookie: $_"} @cookie); | ||
| 70 | # if the user indicates an expiration time, then we need | ||||
| 71 | # both an Expires and a Date header (so that the browser is | ||||
| 72 | # uses OUR clock) | ||||
| 73 | 1 | 0s | push(@header,"Expires: " . expires($expires,'http')) | ||
| 74 | if $expires; | ||||
| 75 | 1 | 47µs | 2 | 83µs | push(@header,"Date: " . expires(0,'http')) if $expires || $cookie || $nph; # spent 45µs making 1 call to CGI::Cookie::as_string
# spent 38µs making 1 call to CGI::Util::expires |
| 76 | 1 | 103µs | 1 | 103µs | push(@header,"Pragma: no-cache") if $self->cache(); # spent 103µs making 1 call to CGI::AUTOLOAD |
| 77 | 1 | 100ns | push(@header,"Content-Disposition: attachment; filename=\"$attachment\"") if $attachment; | ||
| 78 | 1 | 4µs | push(@header,map {ucfirst $_} @other); | ||
| 79 | 1 | 900ns | push(@header,"Content-Type: $type") if $type ne ''; | ||
| 80 | 1 | 3µs | my $header = join($CRLF,@header)."${CRLF}${CRLF}"; | ||
| 81 | 1 | 500ns | if (($MOD_PERL >= 1) && !$nph) { | ||
| 82 | $self->r->send_cgi_header($header); | ||||
| 83 | return ''; | ||||
| 84 | } | ||||
| 85 | 1 | 2µs | return $header; | ||
| 86 | } | ||||
| 87 | |||||
| 88 | ; | ||||
# spent 22µs within CGI::CORE:match which was called 17 times, avg 1µs/call:
# 8 times (6µs+0s) by C4::Output::output_with_http_headers at line 31, avg 700ns/call
# 4 times (15µs+0s) by C4::Output::output_with_http_headers at line 50, avg 4µs/call
# 4 times (800ns+0s) by C4::Output::output_with_http_headers or CGI::unescapeHTML at line 6 of (eval 1142)[CGI.pm:932], avg 200ns/call
# once (500ns+0s) by C4::Output::output_with_http_headers at line 54 | |||||
sub CGI::CORE:regcomp; # opcode | |||||
# spent 10µs within CGI::CORE:subst which was called 16 times, avg 594ns/call:
# 8 times (2µs+0s) by C4::Output::output_with_http_headers at line 28, avg 262ns/call
# 4 times (6µs+0s) by C4::Output::output_with_http_headers at line 51, avg 1µs/call
# 4 times (2µs+0s) by C4::Output::output_with_http_headers or CGI::unescapeHTML at line 9 of (eval 1142)[CGI.pm:932], avg 425ns/call | |||||
# spent 5µs within CGI::CORE:substcont which was called 8 times, avg 650ns/call:
# 8 times (5µs+0s) by C4::Output::output_with_http_headers at line 51, avg 650ns/call |